#!/usr/bin/perl

use strict;
use warnings;

use Perl::Tidy;
use IPC::Open3;

our $VERSION = '0.1';

my $block = '';
my $preamble = '';
my $state = 'html';
my $debug = 0;

for my $line (<STDIN>){

    if(     $line =~ /^<%(perl|init|once)>/){
        finish_block();
        start_block('perl', $line);

    }elsif( $line =~ /^<\/%(perl|init|once)>/){
        finish_block($line);
        start_block('html');

    }elsif( $state eq 'html' && $line =~ /^%/){
        finish_block();
        perl_line($line);
        start_block('html');

    }elsif( $line =~ /^<%/ ){
        finish_block();
        start_block('mason', $line);

    }elsif( $line =~ /^<\/%/ ){
        finish_block($line);
        start_block('html');
    }else{
        continue_block($line);
    }

}

finish_block();

exit;


sub perl_line {
    my $line = shift;

    $line =~ s/^% *//;

    print '% '.perl_tidy($line);
}


sub finish_block {
    my $postamble = shift || '';

    my $buffer = '';
    if($block ne ''){
        if($state eq 'perl'){
            $buffer = perl_tidy($block);
        }elsif($state eq 'mason'){
            $buffer = $block;
        }elsif($state eq 'html'){
            $buffer = htmltidy($block);
        }
    }

    # This enforces no leading/trailing space inside <%> blocks
    # and one space between them:
    $buffer =~ s/^\s+|\s+$//gs;
    print $preamble if $preamble;
    print "$buffer\n" if $buffer;
    print "$postamble\n" if $postamble;


    print "Finished $state block: $postamble" if $debug;

}


sub start_block {
    $state = shift;
    $preamble = shift || '';
    print "Starting $state block: $preamble" if $debug;
    $block = ''
}


sub continue_block {
    $block .= shift;
}


sub perl_tidy {
    my $source = shift;

    my ($buffer, $error, $errors);

    Perl::Tidy::perltidy(
        source      => \$source,
        destination => \$buffer,
        errorfile   => \$errors,
        stderr      => \$error,
    );

    warn "perl_tidy stderr: $error" if $debug;
    warn "perl_tidy errors: $errors" if $debug;

    return $buffer;
}


sub htmltidy {

    return '' unless $block =~ /[^\s]/;

    if($block !~ /<body/){
        $block = "<body>$block</body>";
    }

    # we have to game tidy a bit - it respects asp,jsp,php,etc but not
    # mason, so we make mason comp calls look like something else:
    $block =~ s/<\/&>/<# content #>/gs;
    $block =~ s/<&/<#/gs;
    $block =~ s/&>/#>/gs;

    my $pid = open3(\*TIDY_IN, \*TIDY_OUT, \*TIDY_ERR, 
        'tidy',
        '-config', '~/.tidyrc',
    );

    print TIDY_IN $block;
    close TIDY_IN;

    my $buffer = join('', <TIDY_OUT>);
    my $error = join('', <TIDY_ERR>);

    close TIDY_OUT;
    close TIDY_ERR;

    waitpid($pid, 0);

    warn "html_tidy errors: $error" if $debug;

    $buffer =~ s/<# content #>/<\/&>/gs;
    $buffer =~ s/<#/<&/gs;
    $buffer =~ s/#>/&>/gs;

    return $buffer;
}

